home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gnat1792.zip
/
gnat179b
/
t-adainc
/
a-strunb.adb
< prev
next >
Wrap
Text File
|
1994-05-19
|
15KB
|
559 lines
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . S T R I N G S . U N B O U N D E D --
-- --
-- B o d y --
-- --
-- $Revision: 1.5 $ --
-- --
-- Copyright (c) 1992,1993,1994 NYU, All Rights Reserved --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
-- --
------------------------------------------------------------------------------
-- Note: This code is derived from the ADAR.CSH public domain Ada 83
-- versions of the Appendix C string handling packages.
with Ada.Strings.Fixed;
with Ada.Strings.Search;
with Ada.Unchecked_Deallocation;
package body Ada.Strings.Unbounded is
-----------------------
-- Local Subprograms --
-----------------------
procedure Free (Handle : in out Unbounded_String);
-- Free an unbounded string using unchecked deallocation. This is used
-- only internally to this package by those routines which must be sure
-- to free a string before reassigning it. This is a temporary kludge
-- to make up for the fact that we do not have finalization yet! ???
---------
-- "=" --
---------
function "=" (Left, Right : Unbounded_String) return Boolean is
begin
return Left.Reference.all = Right.Reference.all;
end "=";
---------
-- "<" --
---------
function "<" (Left, Right : Unbounded_String) return Boolean is
begin
return Left.Reference.all < Right.Reference.all;
end "<";
----------
-- "<=" --
----------
function "<=" (Left, Right : Unbounded_String) return Boolean is
begin
return Left.Reference.all <= Right.Reference.all;
end "<=";
---------
-- ">" --
---------
function ">" (Left, Right : Unbounded_String) return Boolean is
begin
return Left.Reference.all > Right.Reference.all;
end ">";
----------
-- ">=" --
----------
function ">=" (Left, Right : Unbounded_String) return Boolean is
begin
return Left.Reference.all >= Right.Reference.all;
end ">=";
---------
-- "*" --
---------
function "*"
(Left : Natural;
Right : Character)
return Unbounded_String
is
Result : Unbounded_String := (Reference => new String (1 .. Left));
begin
Result.Reference.all := (1 .. Left => Right);
return Result;
end "*";
function "*"
(Left : Natural;
Right : String)
return Unbounded_String
is
Result : Unbounded_String :=
(Reference => new String (1 .. Left * Right'Length));
begin
for J in 1 .. Left loop
Result.Reference.all
(Right'Length * J - Right'Length + 1 .. Right'Length * J) := Right;
end loop;
return Result;
end "*";
function "*"
(Left : Natural;
Right : Unbounded_String)
return Unbounded_String
is
R_Length : constant Integer := Right.Reference.all'Length;
Result : Unbounded_String :=
(Reference => new String (1 .. Left * Right.Reference.all'Length));
begin
for I in 1 .. Left loop
Result.Reference.all (R_Length * I - R_Length + 1 .. R_Length * I) :=
Right.Reference.all;
end loop;
return Result;
end "*";
---------
-- "&" --
---------
function "&"
(Left, Right : Unbounded_String)
return Unbounded_String
is
L_Length : constant Integer := Left.Reference.all'Length;
R_Length : constant Integer := Right.Reference.all'Length;
Length : constant Integer := L_Length + R_Length;
Result : Unbounded_String := (Reference => new String (1 .. Length));
begin
Result.Reference.all (1 .. L_Length) := Left.Reference.all;
Result.Reference.all (L_Length + 1 .. Length) := Right.Reference.all;
return Result;
end "&";
function "&"
(Left : Unbounded_String;
Right : String)
return Unbounded_String
is
L_Length : constant Integer := Left.Reference.all'Length;
Length : constant Integer := L_Length + Right'Length;
Result : Unbounded_String := (Reference => new String (1 .. Length));
begin
Result.Reference.all (1 .. L_Length) := Left.Reference.all;
Result.Reference.all (L_Length + 1 .. Length) := Right;
return Result;
end "&";
function "&"
(Left : String;
Right : Unbounded_String)
return Unbounded_String
is
R_Length : constant Integer := Right.Reference.all'Length;
Length : constant Integer := Left'Length + R_Length;
Result : Unbounded_String := (Reference => new String (1 .. Length));
begin
Result.Reference.all (1 .. Left'Length) := Left;
Result.Reference.all (Left'Length + 1 .. Length) := Right.Reference.all;
return Result;
end "&";
function "&"
(Left : Unbounded_String;
Right : Character)
return Unbounded_String
is
Length : constant Integer := Left.Reference.all'Length + 1;
Result : Unbounded_String := (Reference => new String (1 .. Length));
begin
Result.Reference.all (1 .. Length - 1) := Left.Reference.all;
Result.Reference.all (Length) := Right;
return Result;
end "&";
function "&"
(Left : Character;
Right : Unbounded_String)
return Unbounded_String
is
Length : constant Integer := Right.Reference.all'Length + 1;
Result : Unbounded_String := (Reference => new String (1 .. Length));
begin
Result.Reference.all (1) := Left;
Result.Reference.all (2 .. Length) := Right.Reference.all;
return Result;
end "&";
-----------
-- Count --
-----------
function Count
(Source : Unbounded_String;
Pattern : String;
Mapping : Maps.Character_Mapping := Maps.Identity)
return Natural
is
begin
return Search.Count (Source.Reference.all, Pattern, Mapping);
end Count;
function Count
(Source : Unbounded_String;
Set : Maps.Character_Set)
return Natural
is
begin
return Search.Count (Source.Reference.all, Set);
end Count;
------------
-- Create --
------------
procedure Create
(Target : in out Unbounded_String;
Length : Natural)
is
begin
Free (Target);
Target := (Reference => new String (1 .. Length));
end Create;
------------
-- Delete --
------------
function Delete
(Source : Unbounded_String;
From : Positive;
Through : Natural)
return Unbounded_String
is
begin
return
To_Unbounded_String
(Fixed.Delete (Source.Reference.all, From, Through));
end Delete;
-------------
-- Element --
-------------
function Element